home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / powertb.arc / WINDOWS.INC < prev   
Encoding:
Text File  |  1986-02-16  |  3.4 KB  |  138 lines
  1. { Turbo Pascal removable window system
  2.   Copywrite 1984 Michael A. Covington }
  3.  
  4. { Requirements: IBM PC or close compatible.
  5.   Screen must be in text mode on page 1,
  6.   either mono or color card.
  7.  
  8.   Call INITWIN berfore calling MKWIN or RMWIN
  9. }
  10.  
  11. const maxwin = 5;  { maximum number of windows open at once }
  12.  
  13. type imagetype  = array [1..4096] of char;
  14.      windimtype = record
  15.                      x1,y1,x2,y2: integer
  16.                   end;
  17.  
  18. var win: { global variable package }
  19.         record
  20.           dim:   windimtype;  { current window dimensions }
  21.           depth: integer;
  22.           stack: array [1..maxwin] of
  23.                    record
  24.                      image: imagetype;  { Saved screen attributes }
  25.                      dim:   windimtype; { Saved window dimensions }
  26.                      x,y:   integer;    { Saved cursor position }
  27.                    end
  28.           end;
  29.  
  30.     crtmode:     byte      absolute $0040:$0049;
  31.     crtwidth:    byte      absolute $0040:$004A;
  32.     monobuffer:  imagetype absolute $B000:$0000;
  33.     colorbuffer: imagetype absolute $B800:$0000;
  34.  
  35. {================}
  36. procedure initwin;
  37. {================}
  38.  
  39. { Records initial window dimensions }
  40.  
  41. begin
  42.    with win.dim do
  43.       begin x1:=1; y1:=1; x2 := crtwidth; y2:=25 end;
  44.    win.depth := 0
  45. end;
  46.  
  47. {=====================================}
  48. procedure boxwin(x1,y1,x2,y2: integer);
  49. {=====================================}
  50.  
  51. { Draws a box, fills it with blanks, and makes it the current
  52.   winddow.  Dimensions given are for the box; actual window
  53.   is one unit smaller in each direction.
  54.   This routine can be used seperately from the rest of the
  55.   removable window package.
  56. }
  57. var  x,y:  integer;
  58.  
  59. begin
  60.    window(1,1,80,25);
  61.  
  62.    {top}
  63.    gotoxy(x1,y1);
  64.    write(#213);
  65.    for x:=x1+1 to x2-1 do write(#205);
  66.    write(#184);
  67.  
  68.    {sides}
  69.    for y := y1+1 to y2-1 do begin
  70.       gotoxy(x1,y);
  71.       write(#179,' ':x2-x1-1,#179);
  72.       end;
  73.  
  74.    {bottom}
  75.    gotoxy(x1,y2);
  76.    write(#212);
  77.    for x := x1+1 to x2-1 do write(#205);
  78.    write(#190);
  79.  
  80.    {make it the current window}
  81.    window(x1+1,y1+1,x2-1,y2-1);
  82.    gotoxy(1,1)
  83. end;
  84.  
  85. {===================================}
  86. procedure mkwin(x1,y1,x2,y2:integer);
  87. {===================================}
  88.  
  89. { Create a removable window }
  90.  
  91. begin
  92.    { increment stack pointer }
  93.    with win do depth := depth + 1;
  94.    if win.depth > maxwin then begin
  95.       writeln(^G,' Windows nested too deep ');
  96.       halt
  97.       end;
  98.  
  99.    { save contents of the screen }
  100.    if crtmode = 7 then
  101.       win.stack[win.depth].image := monobuffer
  102.    else
  103.       win.stack[win.depth].image := colorbuffer;
  104.  
  105.    win.stack[win.depth].dim := win.dim;
  106.    win.stack[win.depth].x   := wherex;
  107.    win.stack[win.depth].y   := wherey;
  108.  
  109.    { create the window }
  110.    boxwin(x1,y1,x2,y2);
  111.    win.dim.x1 := x1+1;
  112.    win.dim.y1 := y1+1;
  113.    win.dim.x2 := x2-1;
  114.    win.dim.y2 := y2-1;
  115. end;
  116.  
  117. {==============}
  118. procedure rmwin;
  119. {==============}
  120.  
  121. { Remove the most recently created removable window
  122.   Restore screen contents, winodw dimensions, and
  123.   position of coursor. }
  124.  
  125. begin
  126.    if crtmode = 7 then
  127.      monobuffer := win.stack[win.depth].image
  128.    else
  129.      colorbuffer := win.stack[win.depth].image;
  130.  
  131.    with win do begin
  132.       dim := stack[depth].dim;
  133.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  134.       gotoxy(stack[depth].x,stack[depth].y);
  135.       depth := depth - 1
  136.       end
  137. end;
  138.